#!/usr/bin/perl

=head1 NAME

marc_merge_vufind.pl

=d1 NAMEhead2 AUTHOR

Paul Johnson, August 2010

=head1 SYNOPSIS

Merges MARC records into a Solr database.

=head1 USAGE

Usage:

marc_merge_vufind.pl infile outfile institution_code

e.g. marc_merge_vufind.pl marcfile.mrc loadfile.mrc SU

The merger process:

1. Empty the VuFind SOLR indexes (i.e. remove /usr/local/vufind/solr/biblio/index)
2. Run this script against the first file
3. Import the first file into SOLR
4. Run the script against additional file
5. Import the additional file into SOLR

The script will:

- Extract an ISBN/ISSN, add it to 001 (in 13-digit format for ISBNs)
  If there is no ISBN/ISSN, it will retain the existing 001, but prefix it with the institution code (so there is no  conflict of numbers from different sources)

- Add the incoming system number into a 969 field, in the form $aInstitution code $bInstitution code & System number (e.g. 969 $aSU $bSU12345)

- Attempt to find a record with the extracted ISN on SOLR. If present, it will :
    > extract the record
    > decide whether to retain the existing or incoming record
    > merge chosen fields into the chosen record from the other one. Merged fields have an institution identifier added (in $a or $5, depending on the field).

- Write the record to the output file.

N.B. This version of the script gives preference to Swansea University (SU) records when merging. It also contains some special stuff for Carmarthen's (TSDC) Horizon records, because they don't have an 001 field.

=cut

use MARC::Batch;
use MARC::Record;
use MARC::Field;
use LWP::Simple;
use Business::ISBN;
use bytes;
use utf8;

my $batch1 = MARC::Batch->new("USMARC","$ARGV[0]");
$batch1->strict_off();


open (MARCOUT,">$ARGV[1]") or die "Can't open outout file $ARGV[1]";
open (DIAGOUT,">diag.mrc") or die "Can't open DIAG file";

$source_system = $ARGV[2] or die "no system id provided (eg susx)";
$addcr = $ARGV[3];

my %charconv = (
     "#00;"  => "\x00",
     "#01;"  => "\x01",
     "#02;"  => "\x02",
     "#03;"  => "\x03",
     "#04;"  => "\x04",
     "#05;"  => "\x05",
     "#06;"  => "\x06",
     "#07;"  => "\x07",
     "#08;"  => "\x08",
     "#09;"  => "\x09",
     "#10;"  => "\x0A",
     "#11;"  => "\x0B",
     "#12;"  => "\x0C",
     "#13;"  => "\x0D",
     "#14;"  => "\x0E",
     "#15;"  => "\x0F",
     "#16;"  => "\x10",
     "#17;"  => "\x11",
     "#18;"  => "\x12",
     "#19;"  => "\x13",
     "#20;"  => "\x14",
     "#21;"  => "\x15",
     "#22;"  => "\x16",
     "#23;"  => "\x17",
     "#24;"  => "\x18",
     "#25;"  => "\x19",
     "#26;"  => "\x1A",
     "#27;"  => "\x1B",
     "#28;"  => "\x1C",
     "#29;"  => "\x1D",
     "#30;"  => "\x1E",
     "#31;"  => "\x1F",
     "#32;"  => "\x20",
     "#33;"  => "\x21",
     "#34;"  => "\x22",
     "#35;"  => "\x23",
     "#36;"  => "\x24",
     "#37;"  => "\x25",
     "#38;"  => "\x26",
     "#39;"  => "\x27",
     "#40;"  => "\x28",
     "#41;"  => "\x29",
     "#42;"  => "\x2A",
     "#43;"  => "\x2B",
     "#44;"  => "\x2C",
     "#45;"  => "\x2D",
     "#46;"  => "\x2E",
     "#47;"  => "\x2F",
     "#48;"  => "\x30",
     "#49;"  => "\x31",
     "#50;"  => "\x32",
     "#51;"  => "\x33",
     "#52;"  => "\x34",
     "#53;"  => "\x35",
     "#54;"  => "\x36",
     "#55;"  => "\x37",
     "#56;"  => "\x38",
     "#57;"  => "\x39",
     "#58;"  => "\x3A",
     "#59;"  => "\x3B",
     "#60;"  => "\x3C",
     "#61;"  => "\x3D",
     "#62;"  => "\x3E",
     "#63;"  => "\x3F",
     "#64;"  => "\x40",
     "#65;"  => "\x41",
     "#66;"  => "\x42",
     "#67;"  => "\x43",
     "#68;"  => "\x44",
     "#69;"  => "\x45",
     "#70;"  => "\x46",
     "#71;"  => "\x47",
     "#72;"  => "\x48",
     "#73;"  => "\x49",
     "#74;"  => "\x4A",
     "#75;"  => "\x4B",
     "#76;"  => "\x4C",
     "#77;"  => "\x4D",
     "#78;"  => "\x4E",
     "#79;"  => "\x4F",
     "#80;"  => "\x50",
     "#81;"  => "\x51",
     "#82;"  => "\x52",
     "#83;"  => "\x53",
     "#84;"  => "\x54",
     "#85;"  => "\x55",
     "#86;"  => "\x56",
     "#87;"  => "\x57",
     "#88;"  => "\x58",
     "#89;"  => "\x59",
     "#90;"  => "\x5A",
     "#91;"  => "\x5B",
     "#92;"  => "\x5C",
     "#93;"  => "\x5D",
     "#94;"  => "\x5E",
     "#95;"  => "\x5F",
     "#96;"  => "\x60",
     "#97;"  => "\x61",
     "#98;"  => "\x62",
     "#99;"  => "\x63",
     "#100;"  => "\x64",
     "#101;"  => "\x65",
     "#102;"  => "\x66",
     "#103;"  => "\x67",
     "#104;"  => "\x68",
     "#105;"  => "\x69",
     "#106;"  => "\x6A",
     "#107;"  => "\x6B",
     "#108;"  => "\x6C",
     "#109;"  => "\x6D",
     "#110;"  => "\x6E",
     "#111;"  => "\x6F",
     "#112;"  => "\x70",
     "#113;"  => "\x71",
     "#114;"  => "\x72",
     "#115;"  => "\x73",
     "#116;"  => "\x74",
     "#117;"  => "\x75",
     "#118;"  => "\x76",
     "#119;"  => "\x77",
     "#120;"  => "\x78",
     "#121;"  => "\x79",
     "#122;"  => "\x7A",
     "#123;"  => "\x7B",
     "#124;"  => "\x7C",
     "#125;"  => "\x7D",
     "#126;"  => "\x7E",
     "#127;"  => "\x7F",
     "#128;"  => "\x80",
     "#129;"  => "\x81",
     "#130;"  => "\x82",
     "#131;"  => "\x83",
     "#132;"  => "\x84",
     "#133;"  => "\x85",
     "#134;"  => "\x86",
     "#135;"  => "\x87",
     "#136;"  => "\x88",
     "#137;"  => "\x89",
     "#138;"  => "\x8A",
     "#139;"  => "\x8B",
     "#140;"  => "\x8C",
     "#141;"  => "\x8D",
     "#142;"  => "\x8E",
     "#143;"  => "\x8F",
     "#144;"  => "\x90",
     "#145;"  => "\x91",
     "#146;"  => "\x92",
     "#147;"  => "\x93",
     "#148;"  => "\x94",
     "#149;"  => "\x95",
     "#150;"  => "\x96",
     "#151;"  => "\x97",
     "#152;"  => "\x98",
     "#153;"  => "\x99",
     "#154;"  => "\x9A",
     "#155;"  => "\x9B",
     "#156;"  => "\x9C",
     "#157;"  => "\x9D",
     "#158;"  => "\x9E",
     "#159;"  => "\x9F",
     "#160;"  => "\xA0",
     "#161;"  => "\xA1",
     "#162;"  => "\xA2",
     "#163;"  => "\xA3",
     "#164;"  => "\xA4",
     "#165;"  => "\xA5",
     "#166;"  => "\xA6",
     "#167;"  => "\xA7",
     "#168;"  => "\xA8",
     "#169;"  => "\xA9",
     "#170;"  => "\xAA",
     "#171;"  => "\xAB",
     "#172;"  => "\xAC",
     "#173;"  => "\xAD",
     "#174;"  => "\xAE",
     "#175;"  => "\xAF",
     "#176;"  => "\xB0",
     "#177;"  => "\xB1",
     "#178;"  => "\xB2",
     "#179;"  => "\xB3",
     "#180;"  => "\xB4",
     "#181;"  => "\xB5",
     "#182;"  => "\xB6",
     "#183;"  => "\xB7",
     "#184;"  => "\xB8",
     "#185;"  => "\xB9",
     "#186;"  => "\xBA",
     "#187;"  => "\xBB",
     "#188;"  => "\xBC",
     "#189;"  => "\xBD",
     "#190;"  => "\xBE",
     "#191;"  => "\xBF",
     "#192;"  => "\xC0",
     "#193;"  => "\xC1",
     "#194;"  => "\xC2",
     "#195;"  => "\xC3",
     "#196;"  => "\xC4",
     "#197;"  => "\xC5",
     "#198;"  => "\xC6",
     "#199;"  => "\xC7",
     "#200;"  => "\xC8",
     "#201;"  => "\xC9",
     "#202;"  => "\xCA",
     "#203;"  => "\xCB",
     "#204;"  => "\xCC",
     "#205;"  => "\xCD",
     "#206;"  => "\xCE",
     "#207;"  => "\xCF",
     "#208;"  => "\xD0",
     "#209;"  => "\xD1",
     "#210;"  => "\xD2",
     "#211;"  => "\xD3",
     "#212;"  => "\xD4",
     "#213;"  => "\xD5",
     "#214;"  => "\xD6",
     "#215;"  => "\xD7",
     "#216;"  => "\xD8",
     "#217;"  => "\xD9",
     "#218;"  => "\xDA",
     "#219;"  => "\xDB",
     "#220;"  => "\xDC",
     "#221;"  => "\xDD",
     "#222;"  => "\xDE",
     "#223;"  => "\xDF",
     "#224;"  => "\xE0",
     "#225;"  => "\xE1",
     "#226;"  => "\xE2",
     "#227;"  => "\xE3",
     "#228;"  => "\xE4",
     "#229;"  => "\xE5",
     "#230;"  => "\xE6",
     "#231;"  => "\xE7",
     "#232;"  => "\xE8",
     "#233;"  => "\xE9",
     "#234;"  => "\xEA",
     "#235;"  => "\xEB",
     "#236;"  => "\xEC",
     "#237;"  => "\xED",
     "#238;"  => "\xEE",
     "#239;"  => "\xEF",
     "#240;"  => "\xF0",
     "#241;"  => "\xF1",
     "#242;"  => "\xF2",
     "#243;"  => "\xF3",
     "#244;"  => "\xF4",
     "#245;"  => "\xF5",
     "#246;"  => "\xF6",
     "#247;"  => "\xF7",
     "#248;"  => "\xF8",
     "#249;"  => "\xF9",
     "#250;"  => "\xFA",
     "#251;"  => "\xFB",
     "#252;"  => "\xFC",
     "#253;"  => "\xFD",
     "#254;"  => "\xFE",
     "#255;"  => "\xFF",
     "&lt;"   => "\x3c",
     "&gt;"   => "\x3e",
     "&amp;"  => "&"
);

# fields to be retained in MARC records


sub trim_isn($)
# removes hyphens and ignores stuff at the end of an ISBN subfield
{
  my $isbn = shift;
  my $newisbn = "";

  for ($pos = 0; $pos <= length($isbn); $pos++) 
  {
    $curchar = substr($isbn,$pos,1);
    if ($curchar =~ m/[0-9Xx]/)
    {
      $newisbn = $newisbn.$curchar;
    } else 
    {
      if ($curchar ne "-") 
      {   
        return $newisbn;
      }
    }
  }
    return $newisbn;
}

sub sort_cnums()
{
  if ($source_system eq "TSDC") 
  {
    $cnum = $record1->subfield('999',"a");
  } else 
  {
    $field001 = $record1->field('001');
    if ($field001 eq "") {
      $cnum = "NN".$source_system.$dumnum;
      $new001 = MARC::Field->new('001',$cnum);
      print "Local number only $cnum\n";
      $record1->insert_fields_ordered($new001);
      $field001 = $record1->field('001');
      $dumnum++;
    } else {
    $cnum = $field001->data();
    }
  }

# get the local control number

  if (substr($cnum,0,2) eq "NN") {
    $lnum = $cnum;
  } else {
    $lnum = $source_system.$cnum;
  }
  $localnumfield = MARC::Field->new('969','','','a' => $source_system, 'b' => $lnum);
  
  #$localcataloguefield = MARC::Field->new('856','','','a' => $source_system, 'b' => $lnum);

# get the sbn from the file record, or ssn if no sbn

  $isn = "";

  $isn = $record1->subfield('020',"a");

  if ($isn eq "") 
  { 
    $isn = $record1->subfield('022',"a");
  }
  $isn = trim_isn($isn);

  if (length($isn) == 10) 
  {
    $isbn_valid = 1;
    for ($pos = 0; $pos < 10; $pos++) 
    {
      $curchar = substr($isn,$pos,1);
      if ($curchar !~ m/[0-9]/)
      { 
         $isbn_valid = 0;
      }
    }

    if ($isbn_valid) 
    {
      $isbn10 = Business::ISBN->new($isn);
      $isbn13 = $isbn10->as_isbn13;
      $isn = $isbn13->as_string([]);
    }
  }

  if ($isn ne "") 
  {
    if ($source_system ne "TSDC") 
    {
      $field001->update($isn);
    } else 
    {
      $new001 = MARC::Field->new('001',$isn);
      $record1->insert_fields_ordered($new001);
    }
  } else 
  {
    $isn = $lnum;

    if ($source_system eq "TSDC") 
    {
      $lcnum = "TSDC".$cnum;
      $new001 = MARC::Field->new('001',$lcnum);
      print "Local number only $lcnum\n";
      $record1->insert_fields_ordered($new001);
    } else {
      $field001->update($isn);
    }
  }

}

 my $fieldname = "fullrecord\">";
 my $fieldend = "#29";
 my $records_in = 0;
 my $records_out = 0;
 my $records_matched = 0;
 my $dumnum = 1;

# read a record from the file

while ($record1 = $batch1->next()) {

# print DIAGOUT $record1->as_usmarc,"\n";

  my @fieldsToInsert = ();
  my @mdbkeepfields = ();
  my $marcdb = "";
  my @allrec1fields = ();
  my $newrec = "";

  $records_in++;
  print "$records_in\n";

# get the system control number

  sort_cnums();

# see if there is a matching record on the database

  $dbrecord = 0;

  my $url = "http://localhost:17080/solr/biblio/select/?q=id:".
       $isn."&omitHeader&fl=fullrecord&version=2.2&start=0&rows=10&indent=off";

  my $content = get $url;

  $source_present = 0;

# Do we have a record?

  if (index($content,"numFound=\"0\"") == -1) {
    $dbrecord = 1;
  }

# If we have a record, then tidy it up and put it into $marcdb object

  if ($dbrecord == 1) {
    $records_matched++;

# get the marc record out of there

    my $dbmarc = substr($content,index($content, $fieldname)+12);
    $dbmarc = substr($dbmarc,0,index($dbmarc, $fieldend)+4);

# fix characters if necessary

    while ( my ($key, $value) = each(%charconv) ) {
      $dbmarc =~ s/$key/$value/g;
    }

# Put the record into a Perl MARC::Record object

    $marcdb = MARC::Record->new_from_usmarc($dbmarc);
  }

# Get all local fields from the incoming record (i.e. those which are to be retained in the merged record)

  @allrec1fields = $record1->fields();

# 852 and 866 fields are treated differently from others (at Swansea Uni, we had already merged these into the bib records from MFHDs, in order to allow location facets in searches)

  foreach (@allrec1fields) {
    my $newfield = "";
    if ($_->tag() =~ m/852/) {
      my @subfsplit = $_->subfields();
      my $numsubfields = @subfsplit;        
      $subf8 = $_->subfield('8');
      if ($subf8 ne "") {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), '8' => $subf8, 'a' =>
        $source_system );
      } else {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), 'a' => $source_system );
      }
      for ($i = 0; $i < $numsubfields; $i++) {
        if (($subfsplit[$i][0] ne 'a') && ($subfsplit[$i][0] ne '8')) {
          $newfield->add_subfields($subfsplit[$i][0] => $subfsplit[$i][1]);
        }
      }
      if ($numsubfields > 1) {
        push(@fieldsToInsert,$newfield);
      }
    }
    if ($_->tag() =~ m/866/) {
      my @subfsplit = $_->subfields();
      my $numsubfields = @subfsplit;        
      $subf8 = $_->subfield('8');
      if ($subf8 ne "") {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), '8' => $subf8 );
      }
      for ($i = 0; $i < $numsubfields; $i++) {
        if (($subfsplit[$i][0] ne '5') && ($subfsplit[$i][0] ne '8')) {
          if ($newfield eq "") {
            $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), $subfsplit[$i][0] =>
            $subfsplit[$i][1] );
          } else {
            $newfield->add_subfields($subfsplit[$i][0] => $subfsplit[$i][1]);
          }
        }
      }
      $newfield->add_subfields('5' => $source_system);
      push(@fieldsToInsert,$newfield);
    }

# Other mergable fields have $5 with the institution code added

    if ($_->tag() =~ m/509|856/) {
      $newfield = $_->clone();
      $idsubf = $_->subfield('5');
      if ($idsubf eq "") {
        $newfield->add_subfields('5' => $source_system);
      }
      push(@fieldsToInsert,$newfield);
    }

  }

# Get all local fields from the database record, if we have one
 
 if ($dbrecord == 1) {
   @allmdbfields = $marcdb->fields();

    foreach (@allmdbfields) {
      $keepthis = 1;
      if ($_->tag() =~ m/509|852|856|866/) {
        if ($_->tag() =~ m/852/) {
          $instsubf = $_->subfield('a');
          if ($instsubf eq $source_system) {
            $keepthis = 0;
          }
        } else {
          $instsubf = $_->subfield('5');
          if ($instsubf eq $source_system) {
            $keepthis = 0;
          }
        }
        if ($keepthis == 1) {
          push(@mdbkeepfields,$_);
        }
      }
    }
  }

# Give preference to the Swansea/Sussex Uni (SU/susx) record; otherwise the the existing SOLR record takes precedence, if present.

  if (!$dbrecord) {
    $chosen_record = $record1->clone();
  } else {
    if ($source_system eq "susx") {
      $chosen_record = $record1->clone();
    } else {
    $chosen_record = $marcdb->clone();

    }
  }

# Now construct the new record

  @allchosenfields = $chosen_record->fields();
  my $newrec = MARC::Record->new();
  my $recleader = $chosen_record->leader();
  $newrec->leader($recleader);

  my @allchosenfields = reverse(@allchosenfields);
  foreach (@allchosenfields) {
    if ($_->tag() !~ m/509|852|856|866/) {
      $newrec->insert_fields_ordered($_);   
    }
  }

  my @fieldsToInsert = reverse(@fieldsToInsert);
  foreach (@fieldsToInsert) {
      $newrec->insert_fields_ordered($_);
  }

  if ($dbrecord) {
    foreach (@mdbkeepfields) {
        $newrec->insert_fields_ordered($_);
    }
  }

  if ($source_present == 0) {
      $newrec->insert_fields_ordered($localnumfield);
  }

  print MARCOUT $newrec->as_usmarc;

  if ($addcr == 1) { print DIAGOUT $newrec->as_usmarc,"\n"; }
  $records_out++;
}

print "Records in:       $records_in\n";
print "Records out:      $records_out\n";
print "Records matched:  $records_matched\n";
print "Dummy numbers:    $dumnum\n";

